SPACE 2/SPACE - Library 2 - Volume 1.iso/apps/142/applic/spellpic.bas

BASIC Source File | 1987-06-15 | 18KB | 656 lines

10    '**SPELLPIC by D. A. Brumleve***
20    '********Copyright 1987*********
30    '*Released to the Public Domain*
40    '************Enjoy!*************
50    ' Initializations
60    openw 2 : fullw 2 : clearw 2 : ?     ' Used by INTERPRETER only
70    gosub AESINIT:GOSUB INITIALIZE
80    icon%=1:default%=0
90    text$=" |    SPELLPIC|By D. A. Brumleve|Copyright 1987|Public Domainware"
100   choices$="Let's play!"
110   COLOR 1,4,1,1,1:FILL 1,1
120   gosub formalert
130   icon%=1
140   default%=1
150   text$="Use lower case|letters to name the|pictures. Then press|'Return'."
160   choices$="OK."
170   color 1,3,1,1,1:fill 1,1
180   gosub formalert
190   randomize 0
200   DIM SEENIT(10)
210   for ii=1 to 10
220   T=INT(RND*20+1)
230   if ii=1 then goto 270
240   for j=1 to ii-1
250   if seenit(j)=t then goto 220
260   NEXT J
270   seenit(ii)=t
280   CLEARW 2
290   IF T=1 THEN GOSUB QUESTION1
300   IF T=2 THEN GOSUB QUESTION2
310   IF T=3 THEN GOSUB QUESTION3
320   IF T=4 THEN GOSUB QUESTION4
330   IF T=5 THEN GOSUB QUESTION5
340   IF T=6 THEN GOSUB QUESTION6
350   IF T=7 THEN GOSUB QUESTION7
360   IF T=8 THEN GOSUB QUESTION8
370   IF T=9 THEN GOSUB QUESTION9
380   IF T=10 THEN GOSUB QUESTION10
390   IF T=11 THEN GOSUB QUESTION11
400   IF T=12 THEN GOSUB QUESTION12
410   IF T=13 THEN GOSUB QUESTION13
420   IF T=14 THEN GOSUB QUESTION1A
430   IF T=15 THEN GOSUB QUESTION1B
440   IF T=16 THEN GOSUB QUESTION1C
450   IF T=17 THEN GOSUB QUESTION1D
460   IF T=18 THEN GOSUB QUESTION1E
470   IF T=19 THEN GOSUB QUESTION1F
480   IF T=20 THEN GOSUB QUESTION1G
490   next ii
500   CLEARW 2
510   color 1,2,1,1,1:fill 1,1
520   ICON%=1
530   DEFAULT%=0
540   TEXT$="Congratulations!|Do you want to play|the game again?"
550   choices$="Not now.|Great!"
560   gosub formalert
570   if choice%=2 then gosub delay:goto 210
580   CLEARW 2:ICON%=1:DEFAULT%=0
590   text$="If you enjoyed this|game, you may also|enjoy WORDPIC!"
600   choices$="I like that one, too!"
610   color 1,2,1,1,1:fill 1,1
620   gosub formalert
630   gosub delay:gosub delay
640   end
650   WRONGANSWER:
660   GOSUB DUDSOUND
670   CLEARW 2
680   ? "The word is not '"+w$+"'!"
690   ? "Try it again."
700   gosub delay:gosub delay
710   clearw 2:return
720   rightanswer:
730   gosub winsound
740   clearw 2
750   ? "Good for you!!!"
760   ? "The word is '"+w$+"'!"
770   gosub delay:gosub delay
780   return
790   question1:
800   ? "Type a name for the picture."
810   ?:?:?:?
820   gosub redbus
830   GOSUB DELAY:CLEARW 2
840   input w$
850   if w$="bus" or w$="van" then gosub rightanswer:return
860   GOSUB WRONGANSWER
870   goto 790
880   question2:
890   ? "Name the picture."
900   ?:?:?:?
910   gosub car
920   gosub delay:gosub delay:clearw 2
930   input w$
940   if w$="car" or w$="auto" or w$="automobile" then gosub rightanswer:return
950   gosub wronganswer
960   goto 880
970   question3:
980   ? "You can live in a ______."
990   ?:?:?:?
1000  gosub house
1010  gosub delay:gosub delay:clearw 2
1020  input w$
1030  if w$="house" or w$="home" then gosub rightanswer:return
1040  gosub wronganswer
1050  goto 970
1060  question4:
1070  ? "You might fly to the moon"
1080  ? "in this. What is it?"
1090  ?:?:?:?
1100  gosub rocket
1110  gosub delay:gosub delay:clearw 2
1120  input w$
1130  if w$="rocket" or w$="spaceship" then gosub rightanswer:return
1140  gosub wronganswer
1150  goto 1060
1160  question5:
1170  ? "You hit a ball with this."
1180  ? "What is it called?"
1190  ?:?:?:?
1200  gosub racket
1210  gosub delay:gosub delay:clearw 2
1220  input w$
1230  if w$="racket" then gosub rightanswer:return
1240  gosub wronganswer
1250  goto 1160
1260  question6:
1270  ? "You might wear this on"
1280  ? "your foot.  What is it?"
1290  ?:?:?:?
1300  gosub boot
1310  gosub delay:gosub delay:clearw 2
1320  input w$
1330  if w$="boot" then gosub rightanswer:return
1340  gosub wronganswer
1350  goto 1260
1360  question7:
1370  ? "You could ride in this to"
1380  ? "cross a lake. What is it?"
1390  ?:?:?:?
1400  gosub boat
1410  gosub delay:gosub delay:clearw 2
1420  input w$
1430  if w$="boat" or w$="sailboat" then gosub rightanswer:return
1440  gosub wronganswer
1450  goto 1360
1460  question8:
1470  ? "You might use this in your"
1480  ? "yard or garden."
1490  ?:?:?:?
1500  gosub rake
1510  gosub delay:gosub delay:clearw 2
1520  input w$
1530  if w$="rake" then gosub rightanswer:return
1540  gosub wronganswer
1550  goto 1460
1560  question9:
1570  ? "What can you use to"
1580  ? "untangle your hair?"
1590  ?:?:?:?
1600  gosub comb
1610  gosub delay:gosub delay:clearw 2
1620  input w$
1630  if w$="comb" then gosub rightanswer:return
1640  gosub wronganswer
1650  goto 1560
1660  question10:
1670  ? "What shape is this?"
1680  ?:?:?:?
1690  gosub circ
1700  gosub delay:gosub delay:clearw 2
1710  input w$
1720  if w$="circle" or w$="round" then gosub rightanswer:return
1730  gosub wronganswer
1740  goto 1660
1750  question11:
1760  ? " What color is the spot?"
1770  ?:?:?:?
1780  gosub redspot
1790  gosub delay:gosub delay:clearw 2
1800  input w$
1810  if w$="red" then gosub rightanswer:return
1820  gosub wronganswer
1830  goto 1750
1840  question12:
1850  ? " What do you use to ride"
1860  ? "             in the snow?"
1870  ?:?:?:?
1880  gosub sled
1890  gosub delay:gosub delay:clearw 2
1900  input w$
1910  if w$="sled" then gosub rightanswer:return
1920  gosub wronganswer
1930  goto 1840
1940  question13:
1950  ? "What color is the spot?"
1960  ?:?:?:?
1970  gosub bluespot
1980  gosub delay:gosub delay:clearw 2
1990  input w$
2000  if w$="blue" then gosub rightanswer:return
2010  gosub wronganswer
2020  goto 1940
2030  question1A:
2040  ? "You might wear this on"
2050  ? "your foot. What is it?"
2060  ?:?:?:?
2070  gosub shoe
2080  gosub delay:gosub delay:clearw 2
2090  input w$
2100  if w$="shoe" or w$="slipper" then gosub rightanswer:return
2110  gosub wronganswer
2120  goto 2030
2130  question1B:
2140  ? " Turn on the ______!"
2150  ?:?:?:?
2160  gosub lamp
2170  gosub delay:gosub delay:clearw 2
2180  input w$
2190  if w$="lamp" or w$="light" then gosub rightanswer:return
2200  gosub wronganswer
2210  goto 2130
2220  question1C:
2230  ? "You might wear these."
2240  ?:?:?:?
2250  gosub pants
2260  gosub delay:gosub delay:clearw 2
2270  input w$
2280  if w$="pants" or w$="trousers" or w$="jeans" then gosub rightanswer:return
2290  gosub wronganswer
2300  goto 2220
2310  question1D:
2320  ? " You can carry water in this."
2330  ?:?:?:?
2340  gosub pail
2350  gosub delay:gosub delay:clearw 2
2360  input w$
2370  if w$="pail" or w$="bucket" then gosub rightanswer:return
2380  gosub wronganswer
2390  goto 2310
2400  question1E:
2410  ? "Many big plants like this"
2420  ? "grow in the woods."
2430  ? "What is it?"
2440  ?:?:?:?
2450  gosub tree
2460  gosub delay:gosub delay:clearw 2
2470  input w$
2480  if w$="tree" then gosub rightanswer:return
2490  gosub wronganswer
2500  goto 2400
2510  question1F:
2520  ? " You might go camping with this."
2530  ?:?:?:?
2540  gosub tent
2550  gosub delay:gosub delay:clearw 2
2560  input w$
2570  if w$="tent" then gosub rightanswer:return
2580  gosub wronganswer
2590  goto 2510
2600  question1G:
2610  ? " You can tell time with this."
2620  ?:?:?:?
2630  gosub watch
2640  gosub delay:gosub delay:clearw 2
2650  input w$
2660  if w$="watch" or w$="wristwatch" then gosub rightanswer:return
2670  gosub wronganswer
2680  goto 2600
2690  delay:
2700  for d=1 to 1500:next d:return
2710  dudsound:
2720  wave 1,1,1,4096
2730  sound 1,10,1,3,40
2740  sound 1,0,0,0,0
2750  return
2760  winsound:
2770  for i=1 to 3
2780  wave 1,1,12,0,0
2790  sound 1,10,1,6,15
2800  sound 1,0,0,0,0
2810  next i
2820  return
2830  redbus:
2840  linef 130,130,130,160
2850  linef 130,160,200,160
2860  linef 130,130,200,130
2870  linef 200,130,200,160
2880  linef 140,130,140,140
2890  linef 130,140,200,140
2900  circle 140,160,6
2910  circle 190,160,6
2920  linef 130,130,133,128
2930  linef 200,130,197,128
2940  linef 197,128,133,128
2950  color 1,2,1,1,1
2960  fill 131,159
2970  fill 133,129
2980  color 1,1,1,1,1
2990  fill 141,161
3000  fill 140,159
3010  fill 190,161
3020  fill 190,159
3030  return
3040  WATCH:
3050  CIRCLE 150,145,20
3060  LINEF 75,140,75,150
3070  LINEF 75,140,131,140
3080  LINEF 75,150,131,150
3090  LINEF 225,140,225,150
3100  LINEF 225,140,169,140
3110  LINEF 225,150,169,150
3120  LINEF 150,145,150,158
3130  LINEF 150,145,165,145
3140  COLOR 1,0,1,1,1
3150  COLOR 1,4,1,6,2
3160  FILL 76,141
3170  FILL 224,141
3180  COLOR 1,2,1,1,1
3190  FILL 150,140
3200  RETURN
3210  CAR:
3220  LINEF 97,150,102,140
3230  LINEF 151,140,151,150
3240  LINEF 95,150,200,150
3250  LINEF 95,150,100,140
3260  LINEF 200,150,195,140
3270  LINEF 100,140,195,140
3280  LINEF 125,140,135,130
3290  LINEF 175,140,170,130
3300  LINEF 170,130,135,130
3310  LINEF 170,132,134,132
3320  'THE ABOVE LINE DRAWS THE ROOF
3330  LINEF 150,132,150,140
3340  LINEF 152,132,152,140
3350  CIRCLE 115,150,5
3360  CIRCLE 185,150,5
3370  COLOR 1,4,1,1,1
3380  FILL 136,141
3390  FILL 156,141
3400  FILL 115,149
3410  FILL 185,149
3420  FILL 150,131
3430  COLOR 1,1,1,1,1
3440  FILL 115,151
3450  FILL 185,151
3460  LINEF 151,140,151,150
3470  RETURN
3480  HOUSE:
3490  H=20:W=50
3500  X=125:Y=145
3510  GOSUB BOX
3520  H=10:W=10
3530  X=140:Y=155
3540  GOSUB BOX
3550  H=5:W=5
3560  X=165:Y=155
3570  GOSUB BOX
3580  LINEF 125,145,150,130
3590  LINEF 175,145,150,130
3600  COLOR 1,10,1,2,2
3610  FILL 126,146
3620  COLOR 1,4,1,4,2
3630  FILL 150,131
3640  COLOR 1,14,1,1,1
3650  FILL 145,160
3660  FILL 169,156
3670  RETURN
3680  'THIS SUBROUTINE PLOTS A BOX OF HEIGHT H, WIDTH W, ULH CORNER
3690  'AT POINT X,Y
3700  BOX:
3710  LINEF X,Y,X+W,Y
3720  LINEF X+W,Y,X+W,Y+H
3730  LINEF X+W,Y+H,X,Y+H
3740  LINEF X,Y+H,X,Y
3750  RETURN
3760  ROCKET:
3770  H=20:W=70
3780  X=125:Y=145
3790  GOSUB BOX
3800  LINEF 125,145,100,155
3810  LINEF 100,155,125,165
3820  LINEF 200,150,210,150
3830  LINEF 200,155,210,155
3840  LINEF 200,160,210,160
3850  COLOR 1,8,1,1,1
3860  FILL 105,155
3870  FILL 126,155
3880  RETURN
3890  BOAT:
3900  LINEF 150,130,150,155
3910  LINEF 150,130,195,150
3920  LINEF 150,150,195,150
3930  CIRCLE 160,143,5
3940  COLOR 1,2,1,1,1
3950  FILL 160,143
3960  COLOR 1,3,1,1,1
3970  FILL 151,140
3980  LINEF 95,155,135,165
3990  LINEF 95,155,205,155
4000  LINEF 205,155,195,165
4010  LINEF 135,165,195,165
4020  FILL 150,156
4030  RETURN
4040  RAKE:
4050  LINEF  225,145,90,145
4060  LINEF 90,130,90,160
4070  LINEF 90,130,80,130
4080  LINEF 90,160,80,160
4090  LINEF 90,155,80,155
4100  LINEF 90,150,80,150
4110  LINEF 90,145,80,145
4120  LINEF 90,140,80,140
4130  LINEF 90,135,80,135
4140  RETURN
4150  COMB:
4160  LINEF 110,125,190,125
4170  LINEF 110,125,105,135
4180  LINEF 190,125,195,135
4190  LINEF 105,135,195,135
4200  COLOR 1,2,1,1,1
4210  FILL 150,131
4220  LINEF 115,135,115,150
4230  LINEF 110,135,110,150
4240  LINEF 105,135,105,150
4250  LINEF 120,135,120,150
4260  LINEF 125,135,125,150
4270  LINEF 130,135,130,150
4280  LINEF 135,135,135,150
4290  LINEF 140,135,140,150
4300  LINEF 145,135,145,150
4310  LINEF 150,135,150,150
4320  LINEF 155,135,155,150
4330  LINEF 160,135,160,150
4340  LINEF 165,135,165,150
4350  LINEF 170,135,170,150
4360  LINEF 175,135,175,150
4370  LINEF 180,135,180,150
4380  LINEF 185,135,185,150
4390  LINEF 190,135,190,150
4400  LINEF 195,135,195,150
4410  RETURN
4420  RACKET:
4430  CIRCLE 120,145,20
4440  CIRCLE 120,145,18
4450  COLOR 1,1,1,12,3
4460  FILL 120,145
4470  LINEF 140,145,195,145
4480  LINEF 165,146,194,146
4490  LINEF 165,144,194,144
4500  RETURN
4510  REDSPOT:
4520  CIRCLE 150,145,20
4530  COLOR 1,2,1,1,1
4540  FILL 150,145
4550  RETURN
4560  GOSUB DELAY:GOSUB DELAY:GOSUB DELAY
4570  BLUESPOT:
4580  CIRCLE 150,145,20
4590  COLOR 1,4,1,1,1
4600  FILL 150,145
4610  RETURN
4620  CIRC:
4630  CIRCLE 150,145,20
4640  CIRCLE 150,145,15
4650  COLOR 1,3,1,1,1
4660  FILL 167,145
4670  RETURN
4680  boot:
4690  linef 170,165,170,130
4700  linef 170,130,150,130
4710  linef 150,130,150,150
4720  linef 150,150,145,155
4730  linef 145,155,135,160
4740  linef 135,160,130,165
4750  linef 130,165,155,165
4760  linef 155,165,160,160
4770  linef 165,160,170,160
4780  linef 160,160,165,160
4790  linef 165,160,165,165
4800  linef 165,165,170,165
4810  color 1,9,1,5,2
4820  fill 140,163
4830  color 1,1,1,1,1
4840  fill 166,164
4850  return
4860  shoe:
4870  linef 170,165,170,155
4880  linef 170,155,150,155
4890  linef 150,155,140,160
4900  linef 140,160,120,163
4910  linef 120,163,120,165
4920  linef 120,165,155,165
4930  linef 155,165,160,163
4940  linef 160,163,170,163
4950  linef 155,165,170,165
4960  color 1,2,1,1,1
4970  fill 130,162
4980  color 1,1,1,1,1
4990  fill 169,164
5000  linef 147,157,155,158
5010  linef 155,158,165,158
5020  linef 165,158,170,155
5030  linef 144,158,150,160
5040  linef 142,160,148,162
5050  return
5060  lamp:
5070  linef 140,125,160,125
5080  linef 140,125,135,150
5090  linef 160,125,165,150
5100  linef 135,150,165,150
5110  linef 150,150,150,165
5120  linef 151,150,151,165
5130  linef 149,150,149,165
5140  linef 140,165,160,165
5150  linef 140,164,160,164
5160  color 1,14,1,1,1
5170  fill 150,140
5180  linef 145,164,145,162
5190  return
5200  pants:
5210  linef 140,125,135,165
5220  linef 140,125,160,125
5230  linef 160,125,165,165
5240  linef 165,165,155,165
5250  linef 135,165,145,165
5260  linef 145,165,150,135
5270  linef 155,165,150,135
5280  color 1,4,1,4,2
5290  fill 150,126
5300  linef 150,125,150,135
5310  linef 152,125,152,132
5320  linef 152,132,150,135
5330  linef 140,124,160,124
5340  return
5350  PAIL:
5360  LINEF 135,140,165,140
5370  LINEF 135,140,135,145
5380  LINEF 165,140,165,145
5390  LINEF 165,145,160,165
5400  LINEF 135,145,140,165
5410  LINEF 160,165,140,165
5420  COLOR 1,1,1,1,1
5430  FILL 141,164
5440  CIRCLE 150,140,15
5450  CIRCLE 150,140,12
5460  FILL 150,127
5470  RETURN
5480  TREE:
5490  CIRCLE 150,140,15
5500  COLOR 1,3,1,14,2
5510  FILL 150,140
5520  LINEF 147,154,147,165
5530  LINEF 153,154,153,165
5540  LINEF 153,165,147,165
5550  COLOR 1,1,1,4,2
5560  FILL 152,164
5570  RETURN
5580  TENT:
5590  LINEF 90,165,150,125
5600  LINEF 210,165,150,125
5610  LINEF 150,125,150,165
5620  LINEF 180,165,180,145
5630  LINEF 120,165,120,145
5640  LINEF 150,125,140,165
5650  LINEF 150,125,130,165
5660  LINEF 120,165,180,165
5670  COLOR 1,3,1,1,1
5680  FILL 130,140
5690  FILL 155,140
5700  COLOR 1,11,1,1,1
5710  FILL 135,160
5720  COLOR 1,1,1,3,2
5730  FILL 149,145
5740  LINEF 90,165,90,162
5750  LINEF 210,165,210,162
5760  RETURN
5770  SLED:
5780  LINEF 165,140,110,140
5790  LINEF 110,140,125,155
5800  LINEF 125,155,180,155
5810  LINEF 180,155,165,140
5820  COLOR 1,1,1,5,3
5830  FILL 150,145
5840  COLOR 1,1,2,1,1
5850  LINEF 125,155,125,165
5860  LINEF 110,140,110,150
5870  LINEF 180,155,180,165
5880  LINEF 190,165,110,165
5890  LINEF 110,165,105,160
5900  LINEF 105,160,105,155
5910  LINEF 120,150,95,150
5920  LINEF 95,150,90,145
5930  LINEF 90,145,90,140
5940  COLOR 1,0,1,1,1
5950  RETURN
5960  '---------------------------
5970  AESINIT:'Initialize for aes
5980  def seg=0 : aes#=GB
5990  control=peek(aes#)
6000  global=peek(aes#+4)
6010  gintin=peek(aes#+8)
6020  gintout=peek(aes#+12)
6030  addrin#=peek(aes#+16)
6040  addrout#=peek(aes#+20)
6050  ' gemsys(10) 'APPL_INIT  - NOT NEEDED - Done by Basic
6060  gemsys(77) 'GRAF_HANDLE
6070  handle=peek(gintout)
6080  return
6090  '
6100  '
6110  '-----------------------------------------
6120  FORMALERT:'Put a selection of 1-3 items in box
6130  'Output:
6140  '  CHOICE% - which box was selected
6150  'Input (all must be set before calling this routine)
6160  ' (none of the strings may contain '[' or ']')
6170  '  DEFAULT% - value from 0-3; choice used if user hits return
6180  '  ICON% - 0=blank, 1="!", 2="?", 3="STOP"
6190  '  TEXT$ - text string (up to 20 chars per line);'|' is a new line
6200  '  CHOICES$ - text string with up to 3 choices (choices separated by '|')
6210  '        if one choice, it may have up to 20 chars
6220  '        if 2 choices, each may have up to 9 chars
6230  '        if 3 choices, each may have up to 5 chars
6240  '
6250  aesmenu$=str$(icon%)+"]["+text$+"]["+choices$+"]"+chr$(0)+chr$(0)
6260  def seg=0 : amenuaddr!=varptr(aesmenu$) 'For Interpreter
6270  if INTERPRETER then goto formcontinue1
6280  ' The following 2 lines are used only by the LDW compiler
6290  '   since VARPTR works differently for it on strings
6300  amadr#=amenuaddr!:def seg=amenuaddr!:poke 0,0
6310  def seg=0:amenuaddr!=peek(amadr#)
6320  formcontinue1:
6330  poke gintin,default% 'Choice selected if user hits RETURN
6340  poke addrin#,amenuaddr!
6350  gemsys(52)
6360  choice%=peek(gintout)
6370  return
6380  '
6390  '-------------------------------
6400  INITIALIZE: ' General initializations (replaces VDI\VOPNVWK)
6410  copyright$="Copyright 1986 Chris Williams / AccuSoft"
6420  dummy%=switch(3) 'Used by LDW Compiler
6430  INTERPRETER=1:COMPILER=0 'If using ST Interpreter
6440  if switch(3)=3 then INTERPRETER=0:COMPILER=1 'If using LDW Compiler
6450  ' Screen Resolution data
6460  LOW=0 : MEDIUM=0 : HIGH=0
6470  if peek(systab)=1 then HIGH=1
6480  if peek(systab)=2 then MEDIUM=1
6490  if peek(systab)=4 then LOW=1
6500  '
6510  if HIGH then xres%=640:yres%=400:colors%=2:return
6520  if MEDIUM then xres%=640:yres%=200:colors%=4:return
6530  if LOW then xres%=320:yres%=200:colors%=16:return
6540  return 'Undefined resolution
6550  '
ə